perm filename EDFILL.F4[MSS,LCS] blob sn#052370 filedate 1974-01-08 generic text, type T, neo UTF8
00100		SUBROUTINE EDFILL
00200		COMMON/ED/K,NEXT,NN,NX,NY,J
00300		COMMON /RZ/RSZ,IPLT,RJB,CENTR
00400		COMMON /RC/MCLEF(200),IST(4000),MFILL(200)
00500		COMMON/ZN/SCLEF(200,2),DDD
00600		COMMON/LL/LL
00610		COMMON/JJJ/JJJ
00700		DIMENSION IP(50)
00800		EQUIVALENCE(M,SCLEF(1,2)),(IP,IST(3050)),(JT,MFILL(1))
00900	C USE M FOR FLAG IN DREDIT
01100		NIST=IST(2)
01200	15	J=2
01210		LA=1
01300		IST(2)=NIST
01400		CALL HYDPOG(1)
01500		CALL ACCPOG(1)
01600	5	K=MFILL(J)
01800		JJ=J+1
01900		IP(LA)=J
01910		LA=LA+1
01955		IP(LA)=0
02000		DO 2 L=JJ,K
02100		CALL UNPACK(L,NX,NY,MFILL)
02200		NX=GTPT(FLOAT(NX),RJB)
02300		NY=GTPT(FLOAT(NY),CENTR)
02400		IF(L.EQ.JJ)GO TO 3
02500		CALL AVECT(NX,NY)
02600		GO TO 2
02700	3	CALL AIVECT(NX,NY)
02800	2	CONTINUE
02900		CALL DPYOUT(1)
03000		IF(K.EQ.JT)GO TO 4
03100		J=K+1
03200		GO TO 5
03300	C  ABOVE RETRACES FILL OUTLINES
03400	4	IF(NN.LT.3)NN=3
03410		IP(LA)=JT+1
03500		CALL UNPACK(NN,NX,NY,MFILL)
03510		CALL ITYP
03600		NX=GTPT(FLOAT(NX),RJB)
03700		NY=GTPT(FLOAT(NY),CENTR)
03800		CALL SETCUR(NX,NY,0)
03900		CALL EDTYP(K,X,JJJ)
04100		IF(K.EQ.'X'.OR.K.EQ.'F')RETURN
04150	C  F IS TO ADD ON TO FILLER
04200		IF(K.EQ.'D')GO TO 8
04500	570	IF(K.EQ.'A'.OR.K.EQ.'I')GO TO 9
04700	C  TYPE "S n" TO STEP AHEAD (OR BACK) n STEPS
04800	C  NEXT IS FOR NEXT STEP
04900	11	IF(X.EQ.0)X=1
05000		NN=NN+X
05100		IF(NN.GT.JT)RETURN
05200		IF(NN.LT.3)GO TO 4
05300		DO 12 K=1,LA
05400		IF(NN.NE.IP(K))GO TO 12
05500		NN=NN+1
05600	C  AVOIDS WDCNT LOCS.
05700		GO TO 4
05800	12	CONTINUE
05900		GO TO 4
06000	C  NEXT FOR DELETE
06050	8	JJ=1
06100		DO 16 J=LA,1,-1
06200		IF(NN.LT.IP(J))GO TO 16
06210		IF(NN.NE.IP(J)-1)GO TO 24
06220		DO 25 N=J,LA
06230	25	IP(N)=IP(N+1)
06240	C  DELETES A WDCNT POINTER
06250		JJ=2
06260		LA=LA-1
06300	24	DO 17 N=J,LA
06400	17	MFILL(IP(N))=MFILL(IP(N))-JJ
06500	C  REDUCES WDCNTS
06600	13	JT=JT-JJ
06700		DO 18 K=NN,JT
06800	18	MFILL(K)=MFILL(K+JJ)
06850		IF(JT.LT.5)JT=0
06875	C  <5 = NO FILLER
06900		GO TO 15
07000	16	CONTINUE
07100	C  NEXT IS FOR ALTER
07200	9	M=-1
07300		NEXT=NN+1
07400		CALL DREDIT
07500		M=0
07600		IF(K.EQ.'A')GO TO 19
07650		NN=NEXT
07700		JT=JT+1
07800		DO 20 J=1,LA
07900		IF(NN.GT.IP(J))GO TO 20
08000		DO 21 L=J-1,LA
08100	21	MFILL(IP(L))=MFILL(IP(L))+1
08200		DO 23 L=JT,NN,-1
08300	23	MFILL(L)=MFILL(L-1)
08400		GO TO 19
08500	20	CONTINUE
08600	19	CALL REPACK(NN,NX,NY,MFILL)
08700		NN=NEXT
08800		GO TO 15
09000	C  PUT INSERTS HERE
09300		END
09400	
09500		SUBROUTINE EDTYP(K,X,JJJ)
10000		TYPE 57
10100		ACCEPT 1,K,X
10200		IF(K.NE.' ')JJJ=0
14000		IF(K.EQ.':'.OR.JJJ)GO TO 2
14100	C  TYPE "A" OR ":" TO ALTER
15000		IF(K.NE.'G')RETURN
15100		JJJ=-1
15200	2	K='A'
15300		RETURN
16000	57	FORMAT(' TYPE D, A, I OR X ',$)
16100	1	FORMAT(A1,2F)
16200		END
16210	
16220		SUBROUTINE ITYP
16225		COMMON/ED/K,NEXT,NN,NX,NY,J
16230		TYPE 1,NN,NX,NY
16240		RETURN
16250	1	FORMAT(I4,')',2I6)
16260		END